VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjFace"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

' The plane that contains the polygon.
Private plane As New ObjFacePlane

Private NumPts As Integer   ' Number of points.
Private Points() As Point3D ' Data points.

' ************************************************
' Set constants for transmitted light.
' ************************************************
Sub SetKt(n As Single, N1 As Single, N2 As Single, r As Single, G As Single, B As Single)
    plane.SetKt n, N1, N2, r, G, B
End Sub



' ************************************************
' Return the red, green, and blue components of
' the surface at the hit position.
' ************************************************
Public Sub HitColor(depth As Integer, Objects As Collection, r As Integer, G As Integer, B As Integer)
    plane.HitColor depth, Objects, r, G, B
End Sub

' ************************************************
' Return true if the point lies within the
' polygon.
' ************************************************
Function PointInside(x As Single, y As Single, z As Single) As Boolean
Dim i As Integer
Dim xok As Boolean
Dim yok As Boolean
Dim zok As Boolean

    ' See in which coordinates the points differ.
    ' X coordinates.
    For i = 2 To NumPts
        If Points(i - 1).trans(1) <> Points(i).trans(1) _
            Then Exit For
    Next i
    xok = (i <= NumPts)
    
    ' Y coordinates.
    For i = 2 To NumPts
        If Points(i - 1).trans(2) <> Points(i).trans(2) _
            Then Exit For
    Next i
    yok = (i <= NumPts)
    
    ' Z coordinates.
    For i = 2 To NumPts
        If Points(i - 1).trans(3) <> Points(i).trans(3) _
            Then Exit For
    Next i
    zok = (i <= NumPts)
    
    If xok And yok Then
        PointInside = PointInsideXY(x, y)
    ElseIf yok And zok Then
        PointInside = PointInsideYZ(y, z)
    ElseIf xok And zok Then
        PointInside = PointInsideXZ(x, z)
    Else
        PointInside = False
    End If
End Function

' ************************************************
' Compute the distance from point (px, py, pz)
' along vector <vx, vy, vz> to the polygon.
' ************************************************
Public Function RayDistance(px As Single, py As Single, pz As Single, Vx As Single, Vy As Single, Vz As Single) As Single
Dim dist As Single
Dim x As Single
Dim y As Single
Dim z As Single
Dim dx As Single
Dim dy As Single
Dim dz As Single

    ' Find the distance to the plane.
    dist = plane.RayDistance(px, py, pz, Vx, Vy, Vz)
    
    ' If there is no good intersection with the
    ' plane, there's none with the polygon.
    If dist >= INFINITY Then
        RayDistance = INFINITY
        Exit Function
    End If

    ' See if the point of intersection lies within
    ' the polygon.
    
    ' Get the hit location.
    plane.HitLocation x, y, z

    ' See if the point lies inside the projection
    ' onto the X-Y plane.
    If Not PointInside(x, y, z) Then
        RayDistance = INFINITY
        Exit Function
    End If
    
    RayDistance = dist
End Function


' ************************************************
' Return true if the point projection lies within
' this polygon's projection onto the Y-Z plane.
' ************************************************
Function PointInsideYZ(y As Single, z As Single) As Boolean
Dim i As Integer
Dim theta1 As Double
Dim theta2 As Double
Dim dtheta As Double
Dim dy As Double
Dim dz As Double
Dim angles As Double

    dy = Points(NumPts).trans(2) - y
    dz = Points(NumPts).trans(3) - z
    theta1 = Arctan2(CSng(dy), CSng(dz))
    If theta1 < 0 Then theta1 = theta1 + 2 * PI
    For i = 1 To NumPts
        dy = Points(i).trans(2) - y
        dz = Points(i).trans(3) - z
        theta2 = Arctan2(CSng(dy), CSng(dz))
        If theta2 < 0 Then theta2 = theta2 + 2 * PI
        dtheta = theta2 - theta1
        If dtheta > PI Then dtheta = dtheta - 2 * PI
        If dtheta < -PI Then dtheta = dtheta + 2 * PI
        angles = angles + dtheta
        theta1 = theta2
    Next i
    
    PointInsideYZ = (Abs(angles) > 0.001)
End Function

' ************************************************
' Return true if the point projection lies within
' this polygon's projection onto the X-Z plane.
' ************************************************
Function PointInsideXZ(x As Single, z As Single) As Boolean
Dim i As Integer
Dim theta1 As Double
Dim theta2 As Double
Dim dtheta As Double
Dim dx As Double
Dim dz As Double
Dim angles As Double

    dx = Points(NumPts).trans(1) - x
    dz = Points(NumPts).trans(3) - z
    theta1 = Arctan2(CSng(dx), CSng(dz))
    If theta1 < 0 Then theta1 = theta1 + 2 * PI
    For i = 1 To NumPts
        dx = Points(i).trans(1) - x
        dz = Points(i).trans(3) - z
        theta2 = Arctan2(CSng(dx), CSng(dz))
        If theta2 < 0 Then theta2 = theta2 + 2 * PI
        dtheta = theta2 - theta1
        If dtheta > PI Then dtheta = dtheta - 2 * PI
        If dtheta < -PI Then dtheta = dtheta + 2 * PI
        angles = angles + dtheta
        theta1 = theta2
    Next i
    
    PointInsideXZ = (Abs(angles) > 0.001)
End Function

' ************************************************
' Return true if the point projection lies within
' this polygon's projection onto the X-Y plane.
' ************************************************
Function PointInsideXY(x As Single, y As Single) As Boolean
Dim i As Integer
Dim theta1 As Double
Dim theta2 As Double
Dim dtheta As Double
Dim dx As Double
Dim dy As Double
Dim angles As Double

    dx = Points(NumPts).trans(1) - x
    dy = Points(NumPts).trans(2) - y
    theta1 = Arctan2(CSng(dx), CSng(dy))
    If theta1 < 0 Then theta1 = theta1 + 2 * PI
    For i = 1 To NumPts
        dx = Points(i).trans(1) - x
        dy = Points(i).trans(2) - y
        theta2 = Arctan2(CSng(dx), CSng(dy))
        If theta2 < 0 Then theta2 = theta2 + 2 * PI
        dtheta = theta2 - theta1
        If dtheta > PI Then dtheta = dtheta - 2 * PI
        If dtheta < -PI Then dtheta = dtheta + 2 * PI
        angles = angles + dtheta
        theta1 = theta2
    Next i
    
    PointInsideXY = (Abs(angles) > 0.001)
End Function

' ***********************************************
' Define the plane that contains the polygon.
' ***********************************************
Public Sub DefinePlane()
Dim Ax As Single
Dim Ay As Single
Dim Az As Single
Dim Bx As Single
Dim By As Single
Dim Bz As Single
Dim nx As Single
Dim ny As Single
Dim nz As Single

    Ax = Points(2).coord(1) - Points(1).coord(1)
    Ay = Points(2).coord(2) - Points(1).coord(2)
    Az = Points(2).coord(3) - Points(1).coord(3)
    Bx = Points(3).coord(1) - Points(2).coord(1)
    By = Points(3).coord(2) - Points(2).coord(2)
    Bz = Points(3).coord(3) - Points(2).coord(3)
    m3Cross nx, ny, nz, Ax, Ay, Az, Bx, By, Bz
    plane.Initialize _
        Points(1).coord(1), _
        Points(1).coord(2), _
        Points(1).coord(3), _
        nx, ny, nz
End Sub


' ************************************************
' Add one or more points to the polygon.
' ************************************************
Public Sub AddPoint(ParamArray coord() As Variant)
Dim num_pts As Integer
Dim i As Integer
Dim pt As Integer

    num_pts = (UBound(coord) + 1) \ 3
    ReDim Preserve Points(1 To NumPts + num_pts)

    pt = 0
    For i = 1 To num_pts
        Points(NumPts + i).coord(1) = coord(pt)
        Points(NumPts + i).coord(2) = coord(pt + 1)
        Points(NumPts + i).coord(3) = coord(pt + 2)
        Points(NumPts + i).coord(4) = 1#
        pt = pt + 3
    Next i

    NumPts = NumPts + num_pts
End Sub



' ************************************************
' Set constants for reflection.
' ************************************************
Sub SetKr(r As Single, G As Single, B As Single)
    plane.SetKr r, G, B
End Sub
' ************************************************
' Set constants for diffuse reflection.
' ************************************************
Sub SetKd(r As Single, G As Single, B As Single)
    plane.SetKd r, G, B
End Sub

' ************************************************
' Set constants for ambient light.
' ************************************************
Sub SetKa(r As Single, G As Single, B As Single)
    plane.SetKa r, G, B
End Sub
' ************************************************
' Set N and Ks for specular reflection.
' ************************************************
Sub SetSpec(n As Single, s As Single)
    plane.SetSpec n, s
End Sub

' ************************************************
' Apply a transformation matrix to the object.
' ************************************************
Public Sub Apply(M() As Single)
Dim i As Integer

    For i = 1 To NumPts
        m3Apply Points(i).coord, M, Points(i).trans
    Next i
    plane.Apply M
End Sub





